In this preregistered experiment we examined the effect of testing expectancy on the disfluency effect using a recognition memory test.
# read in low test expect data exported from gorilla
setwd(here::here('expt1_recog_data', 'Gorilla_data_low'))
data=here::here('expt1_recog_data', 'Gorilla_data_low') # path to data files
file_list=list.files(data, pattern=".csv") # list of data files
# read in all files
datasetlow <-
do.call("rbind", lapply(file_list, FUN=function(files){
for (i in 1:length(files)){
if(file.exists(files[i])){
message( "now processing:", files[i])
}
}
fread(files, header=TRUE, sep=",", na.strings = "", fill=TRUE)})) #fread makes reading in files quick
#
library(lubridate)
# clean up data! Select data from after the pre-registation!
low<-datasetlow %>%
janitor::clean_names(.) %>%
dplyr::mutate(date=as.Date(utc_date)) %>%
dplyr::filter(date=="08/06/2020" |date=="09/06/2020" , zone_type=="response_button_text")
#response as character
low$response<-as.character(low$response)
#assign column to denot low test expect
low$testexpect<-"low"
# high test expect
setwd(here::here('expt1_recog_data', 'Gorilla_data_high'))
data=here::here('expt1_recog_data', 'Gorilla_data_high') # path to data files
file_list=list.files(data, pattern=".csv") # list of data files
# read in all files
highdata <-
do.call("rbind", lapply(file_list, FUN=function(files){
for (i in 1:length(files)){
if(file.exists(files[i])){
message( "now processing:", files[i])
}
}
fread(files, header=TRUE, sep=",", na.strings = "", fill=TRUE)})) #fread makes reading in files quick
#
library(lubridate)
# a batch of Ss we run before preregistration that should not be included in the analysis
high <-highdata %>%
janitor::clean_names(.) %>%
dplyr::mutate(date=as.Date(utc_date)) %>%
dplyr::filter(date=="08/06/2020" | date=="0009/07/2020" |date=="0010/07/2020" | date=="09/06/2020", zone_type=="response_button_text")
#response as character
high$response<-as.character(high$response)
# assign column to denot high test expect
high$testexpect<-"high"
# bind low and high datasets
high_low<-rbind(high, low)
#response as character
#calculate hit rate and far and compute dprime and other measures
ex4=high_low %>% dplyr::mutate(condition1= dplyr::case_when(
condition == "SF" ~ "Sans Forgetica",
condition =="normal" ~ "Arial",
), isold= dplyr::case_when (
old_new== "old" ~ 1,
old_new== "new" ~ 0),
sayold=dplyr::case_when(
response=="old"~ 1,
response=="new" ~ 0,
))
#classic SDT
sdt <- ex4 %>%
dplyr::mutate(type = "hit",
type = ifelse(isold==1 & sayold==0, "miss", type),
type = ifelse(isold==0 & sayold==0, "cr", type), # Correct rejection
type = ifelse(isold==0 & sayold==1, "fa", type)) # False alarm
sdt <- sdt %>%
dplyr::group_by(participant_private_id, type, condition1, testexpect) %>%
dplyr::summarise(count = n()) %>%
tidyr::spread(type, count) # Format data to one row per person
sdt <- sdt %>%
dplyr::group_by(participant_private_id, condition1, testexpect)%>%
dplyr::mutate(hr = hit / (hit+miss),
fa = fa / (fa+cr)) %>%
dplyr::mutate(hr=case_when(
is.na(hr) ~ 0.99,
TRUE ~ hr),
fa=case_when(
is.na(fa) ~ 0.01,
TRUE ~ fa),
zhr=qnorm(hr),
zfa=qnorm(fa),
dprime = zhr-zfa) %>%
ungroup()
Raincloud plots (Allen et al., 2019) depicting raw data (dots), box plots, and half violin kernel desntiy plots, with mean (red dot). Proportion of “old” responses as a function of Test Expectancy for Experiment 1.
#set up raincloud params
# fig for dprime
highlowaov=sdt %>% select(participant_private_id, condition1, testexpect, dprime) %>%
mutate(testexpect=ifelse(testexpect=="low", "Low Test Expectancy", "High Test Expectancy"))
#plot
bold <- element_text(face = "bold", color = "black", size = 14)
sdtmean= highlowaov %>%
dplyr::group_by(testexpect, condition1) %>%
dplyr::summarise(mean1=mean(dprime))
## `summarise()` regrouping output by 'testexpect' (override with `.groups` argument)
sdt1=sdt %>% select(participant_private_id, condition1, testexpect, hr, fa) %>%
pivot_longer(hr:fa, names_to="type") %>%
dplyr::mutate(isold=case_when(type=="hr" ~ "Old", type=="fa" ~ "New"))
sdt1$isold<-factor(sdt1$isold, levels=c("Old", "New"))
sdt1$Condition<-factor(sdt1$condition1, levels=c("Arial", "Sans Forgetica"))
highlowaov=sdt %>% select(participant_private_id, condition1, testexpect, dprime) %>%
mutate(testexpect=ifelse(testexpect=="low", "Low Test Expectancy", "High Test Expectancy"))
highlowaov_wide<- highlowaov %>%
tidyr::pivot_wider(names_from = "condition1", values_from = "dprime") %>%
dplyr::mutate(Difference=`Sans Forgetica` - Arial)
highlowwide_mean <- highlowaov_wide %>%
dplyr::group_by(testexpect) %>%
dplyr::summarise(mean=mean(Difference))
## `summarise()` ungrouping output (override with `.groups` argument)
# get withinsubject CIs
sfgend_wsci= Rmisc::summarySEwithin(data = highlowaov, measurevar = "dprime",
withinvars = "condition1", betweenvars = "testexpect", idvar = "participant_private_id")
## Automatically converting the following non-factors to factors: testexpect, condition1
#plot
fig1a <- ggplot(highlowaov,aes(x=condition1,y=dprime,fill=condition1))+ facet_grid(~testexpect) +
#geom_flat_violin(position = position_nudge(x = .2, y = 0), alpha = .4,adjust=4)+
geom_point(position=position_jitter(width = .15),size = 1, alpha = 0.2) +
geom_boxplot(aes(x = condition1, y = dprime),outlier.shape = NA,
alpha = 0.3, width = .1, colour = "BLACK") +
geom_line(data=sfgend_wsci,aes(y=dprime, group=1), size=1)+
#stat_summary(fun="mean", geom="point", colour="darkred", size=3) +
geom_pointrange(data=sfgend_wsci, aes(y=dprime, ymin=dprime, ymax=dprime), size=.8, color="darkred")+
theme_cowplot() +
scale_colour_brewer(palette = "Dark2")+
scale_fill_brewer(palette = "Dark2") +
labs(y = "Sensitivity(d')", x = "Typeface") + theme(legend.position = "none") +
geom_label_repel(data=sfgend_wsci, aes(y=dprime, label=round(dprime, 2)), min.segment.length = 0, seed = 42, box.padding = 0.5) +
theme_cowplot(font_size = 14) +
theme(axis.title=bold, legend.position = "none")
fig1a_diff <- ggplot(highlowaov_wide,aes(x=testexpect,y=Difference, fill=testexpect)) +
geom_flat_violin(position = position_nudge(x = .2, y = 0), alpha = .4,adjust=4)+
geom_point(position=position_jitter(width = .18),size = 1, alpha = 0.2) +
geom_boxplot(aes(x = testexpect, y = Difference),outlier.shape = NA,
alpha = 0.3, width = .1, colour = "BLACK") +
stat_summary(fun.data="mean_cl_boot", colour="darkred", size=.8)+
#geom_line(data=sfarial_wsci,aes(y=mean_acc, group=1), size=1)+
#geom_pointrange(data=sfarial_wsci, aes(y=mean_acc, ymin=mean_acc-ci, ymax=mean_acc+ci), size=.5, color="red")+
scale_colour_brewer(palette = "Accent")+
scale_fill_brewer(palette = "Accent") +
labs(y = "Test Difference (Sans Forgetica - Arial", x = "Test Expectancy")+
theme_cowplot(font_size=14)+
theme(legend.position = "none") +
theme(axis.title =bold) +
geom_hline(yintercept = 0, linetype="dotted") +
geom_label_repel(data=highlowwide_mean, aes(y=mean, label=round(mean, 2)), seed=42, box.padding=0.8)
#ANOVA
a1 <- aov_ez("participant_private_id", "dprime", highlowaov,
between = c("testexpect"), within=c("condition1")) # mixed
summary(a1)
##
## Univariate Type III Repeated-Measures ANOVA Assuming Sphericity
##
## Sum Sq num Df Error SS den Df F value Pr(>F)
## (Intercept) 296.652 1 166.184 229 408.7834 < 2.2e-16 ***
## testexpect 2.980 1 166.184 229 4.1058 0.043896 *
## condition1 1.818 1 38.786 229 10.7344 0.001215 **
## testexpect:condition1 0.735 1 38.786 229 4.3369 0.038405 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#kable(summary(a1))
# get JOls from raw data
high
jol_high<- highdata %>%
mutate(testexpect="high")
low
jol_low<-datasetlow %>%
mutate(testexpect="low")
jol_high_low <- rbind(jol_high, jol_low)
#bind high and low
jols<-jol_high_low %>% janitor::clean_names(.) %>% dplyr::mutate(date=as.Date(utc_date)) %>% dplyr::filter(date=="08/06/2020" | date=="0009/07/2020"|date=="0010/07/2020" | date=="09/06/2020", zone_type=="response_slider_endValue" | zone_type=="response_text_entry")
jols$response<-as.numeric(jols$response)
jols1<- jols %>%
dplyr::select(participant_private_id, response, testexpect) %>%
dplyr::mutate(cond=rep(1:2, 231), font=ifelse(cond==1, "SF", "A")) %>%
tidyr::drop_na() %>%
dplyr::mutate(testexpect=ifelse(testexpect=="low", "Low Test Expectancy", "High Test Expectancy"), font=ifelse(font=="A", "Arial", "Sans Forgetica"))
# plot JOLs
# get withinsubject CIs
sfgenjol_wsci= Rmisc::summarySEwithin(data = jols1, measurevar = "response",
withinvars = "font", betweenvars = "testexpect", idvar = "participant_private_id")
## Automatically converting the following non-factors to factors: testexpect, font
jols1mean <- jols1 %>%
dplyr::group_by(testexpect, font) %>%
dplyr::summarise(mean1=mean(response))
## `summarise()` regrouping output by 'testexpect' (override with `.groups` argument)
JOL_wide<- jols1 %>%
dplyr::select(participant_private_id, response, testexpect, font) %>%
tidyr::pivot_wider(names_from = "font", values_from = "response") %>%
dplyr::mutate(Difference=`Sans Forgetica` - Arial)
JOL_mean <- JOL_wide %>%
dplyr::group_by(testexpect) %>%
dplyr::summarise(mean=mean(Difference, na.rm=TRUE))
## `summarise()` ungrouping output (override with `.groups` argument)
figjol <- ggplot(jols1,aes(x=font,y=response,fill=font))+ facet_grid(~testexpect) +
#geom_flat_violin(position = position_nudge(x = .2, y = 0), alpha = .4,adjust=4)+
geom_point(position=position_jitter(width = .15),size = 1, alpha = 0.2) +
geom_boxplot(aes(x = font, y = response),outlier.shape = NA,
alpha = 0.3, width = .1, colour = "BLACK") +
geom_line(data=sfgenjol_wsci,aes(y=response, group=1), size=1)+
#stat_summary(fun="mean", geom="point", colour="darkred", size=3)+
geom_pointrange(data=sfgenjol_wsci, aes(y=response, ymin=response, ymax=response), size=.8, color="darkred")+
theme_cowplot() +
scale_colour_brewer(palette = "Dark2")+
scale_fill_brewer(palette = "Dark2") +
labs(y = "Judgements of Learning", x = "Typeface") + theme(legend.position = "none") +
geom_label_repel(data=sfgenjol_wsci, aes(y=response, label=round(response, 2)), seed = 42, box.padding = 0.8)+
theme_cowplot() +
theme(axis.title=bold, legend.position = "none")
fig2b_diff <- ggplot(JOL_wide,aes(x=testexpect,y=Difference,fill=testexpect)) +
geom_flat_violin(position = position_nudge(x = .2, y = 0), alpha = .4,adjust=4)+
geom_point(position=position_jitter(width = .15),size = 1, alpha = 0.2) +
geom_boxplot(aes(x = testexpect, y = Difference),outlier.shape = NA,
alpha = 0.3, width = .1, colour = "BLACK") +
stat_summary(fun.data="mean_cl_boot", colour="darkred", size=.8)+
#stat_summary(fun="mean", geom="point", colour="darkred", size=3)+
# geom_line(data=sfgenjol_wsci,aes(y=jols, group=1), size=1)+
# geom_pointrange(data=sfgenjol_wsci, aes(y=jols, ymin=jols-ci, ymax=jols+ci), size=.3, color="red")+
scale_colour_brewer(palette = "Accent")+
scale_fill_brewer(palette = "Accent") +
labs(y = "JOL Difference (Sans Forgetica - Arial)", x = "Test Expectancy") + theme(legend.position = "none")+
geom_label_repel(data=JOL_mean, aes(y=mean , label=round(mean, 2)), seed = 42, box.padding = 0.8) +
theme_cowplot(font_size=14)+
theme(legend.position = "none") +
geom_hline(yintercept = 0, linetype="dotted") +
theme(axis.title = bold)
figjol
#6.67
#anova JOLs
a1 <- aov_ez("participant_private_id", "response", jols1,
between = c("testexpect"), within=c("font")) # mixed
summary(a1)
##
## Univariate Type III Repeated-Measures ANOVA Assuming Sphericity
##
## Sum Sq num Df Error SS den Df F value Pr(>F)
## (Intercept) 1575566 1 403702 221 862.5179 < 2.2e-16 ***
## testexpect 29254 1 403702 221 16.0145 8.579e-05 ***
## font 1803 1 14729 221 27.0520 4.509e-07 ***
## testexpect:font 9 1 14729 221 0.1334 0.7152
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#raw gorilla data and extract RTs
datasetlow$testexpt<-"low"
highdata$testexpt<-"high"
rt_high_low <- rbind(datasetlow, highdata)
rt<-rt_high_low %>% janitor::clean_names(.) %>% mutate(date=as.Date(utc_date)) %>% dplyr::filter(date=="08/06/2020" | date=="0009/07/2020"|date=="0010/07/2020" | date=="09/06/2020", zone_type=="continue_button", display=="study")
# get RT and make numeric (Gorilla does not do this)
rt$reaction_time<-as.numeric(rt$reaction_time)
rt1<- rt %>%
dplyr::group_by(participant_private_id, condition, testexpt) %>%
dplyr::select(participant_private_id, condition, testexpt, reaction_time) %>%
dplyr::mutate(sdabove = mean(reaction_time, na.rm=TRUE) + 2.5*sd(reaction_time, na.rm=TRUE)) %>%
dplyr::filter(reaction_time > 150, reaction_time < sdabove) %>%
dplyr::summarise(mean_rt= mean(log(reaction_time))) %>%
mutate(testexpt=ifelse(testexpt=="low", "Low Test Expectancy", "High Test Expectancy"), font=ifelse(condition=="normal", "Arial", "Sans Forgetica")) %>%
select(-condition) %>%
ungroup()
rt_wide <- rt1 %>%
dplyr::select(-condition)%>%
tidyr::pivot_wider(names_from="font", values_from = "mean_rt")%>%
dplyr::mutate(Difference=`Sans Forgetica` - Arial)
rt_wide_mean <- rt_wide %>%
dplyr::group_by(testexpt) %>%
dplyr::summarise(mean=mean(Difference))
## `summarise()` ungrouping output (override with `.groups` argument)
# get withinsubject CIs
sfgenrt_wsci= Rmisc::summarySEwithin(data = rt1, measurevar = "mean_rt",
withinvars = "font", betweenvars = "testexpt", idvar = "participant_private_id")
## Automatically converting the following non-factors to factors: testexpt, font
#plot fig
figrt <- ggplot(rt1,aes(x=font,y=mean_rt,fill=font))+ facet_grid(~testexpt) +
#geom_flat_violin(position = position_nudge(x = .2, y = 0), alpha = .4,adjust=4)+
geom_point(position=position_jitter(width = .15),size = 1, alpha = 0.2) +
geom_boxplot(aes(x = font, y = mean_rt),outlier.shape = NA,
alpha = 0.3, width = .1, colour = "BLACK") +
geom_line(data=sfgenrt_wsci,aes(y=mean_rt, group=1), size=1)+
geom_pointrange(data=sfgenrt_wsci, aes(y=mean_rt, ymin=mean_rt, ymax=mean_rt), size=.8, color="darkred")+
theme_cowplot() +
scale_colour_brewer(palette = "Dark2")+
scale_fill_brewer(palette = "Dark2") +
labs(y = "log(Study Times)", x = "Typeface") + theme(legend.position = "none")+
geom_label_repel(data=sfgenrt_wsci, aes(y=mean_rt, label=round(mean_rt, 2)), min.segment.length = 0, seed = 42, box.padding = 0.8) +
theme_cowplot(font_size=14) +
theme(legend.position = "none", axis.title = bold)
figrt_diff <- ggplot(rt_wide,aes(x=testexpt,y=Difference,fill=testexpt)) +
geom_flat_violin(position = position_nudge(x = .2, y = 0), alpha = .4,adjust=4)+
geom_point(position=position_jitter(width = .15),size = 1, alpha = 0.2) +
geom_boxplot(aes(x = testexpt , y = Difference),outlier.shape = NA,
alpha = 0.3, width = .1, colour = "BLACK") +
stat_summary(fun.data="mean_cl_boot", colour="darkred", size=.8)+
#stat_summary(fun="mean", geom="point", colour="darkred", size=3)+
#geom_line(data=sfgenrt_wsci,aes(y=mean_rt, group=1), size=1)+
#geom_pointrange(data=sfgenrt_wsci, aes(y=mean_rt, ymin=mean_rt-ci, ymax=mean_rt+ci),size=.3, color="red") +
scale_colour_brewer(palette = "Accent")+
scale_fill_brewer(palette = "Accent") +
labs(y = "Time Difference (Sans Forgetica - Arial)", x = "Test Expectancy") + theme(legend.position = "none") +
geom_label_repel(data=rt_wide_mean, aes(y=mean, label=round(mean, 2)), seed = 42, box.padding = 0.5) +
theme_cowplot(font_size=14) +
geom_hline(yintercept = 0, linetype="dotted") +
theme(legend.position = "none", axis.title = bold)
ggsave("figrt.png", width=8, height=4, dpi=300)
figrt
figrt_diff
#write.csv(rt2, file="rt_high_low.csv")
#ttestBF(x=rt2$normal, y=rt
#anova RTs
a1 <- aov_ez("participant_private_id", "mean_rt", rt1,
between = c("testexpt"), within=c("condition")) #
summary(a1)
##
## Univariate Type III Repeated-Measures ANOVA Assuming Sphericity
##
## Sum Sq num Df Error SS den Df F value Pr(>F)
## (Intercept) 20706.2 1 168.431 229 28152.2648 < 2.2e-16 ***
## testexpt 1.1 1 168.431 229 1.5354 0.2166
## condition 0.3 1 1.797 229 33.0251 2.884e-08 ***
## testexpt:condition 0.0 1 1.797 229 1.1292 0.2891
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#kable(summary(a1))
fig1_plot <- plot_grid(
fig1a, figjol, figrt,
labels = "AUTO", ncol= 1, nrow = 3
)
ggsave("figexpt1.png", width=10, height=14, dpi=500)
fig1_diff <- plot_grid(fig1a_diff, fig2b_diff, figrt_diff, labels = "AUTO", ncol=, nrow=3)
ggsave("figexpt1_diff.png", width=10, height=14, dpi=500)
fig1_diff_all <- plot_grid(fig1a, fig1a_diff, figjol, fig2b_diff,figrt, figrt_diff, labels = "AUTO", ncol=2, nrow=3)
ggsave("figexpt1_diff_all.png", width=12, height=14, dpi=500)